home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / julian.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-02-26  |  3.9 KB  |  114 lines
  1. 10  'GREGORIAN->JULIAN->ORDINAL AND ORDINAL->JULIAN->GREGORIAN CONVERSION
  2. 20  '(1)  <Month_name> 3 letters to full name with space terminator. <Day-no.>
  3. 30  '     with comma terminator. Space character between comma and <Year> is
  4. 40  '     optional.
  5. 50  '(2)  MM-DD-YY Where MM & DD may be single digits, YY may be 4 digits
  6. 60  'ORDINAL TO JULIAN AND GREGORIAN FORMAT
  7. 70  'ORDINAL BASE IS 01-01-80 = 1
  8. 80  '                    Arnold Thomsen
  9. 90  '                    3811 N. 60 Place
  10. 100  '                   Scottsdale, Az 85251
  11. 110  '                                              09-16-82 = 990
  12. 120  DEFINT A-Z: DIM TBL(14)
  13. 130  WEEK$="MON TUE WED THU FRI SAT SUN "
  14. 140  MONTH$="JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC "
  15. 150  SCREEN 0,0,0,0: COLOR 7,0: WIDTH 80: KEY OFF: CLS
  16. 160  PRINT:PRINT "Conversion from various date formats to different formats"
  17. 170  PRINT "Notes:"
  18. 180  PRINT "Julian date is printed in all conversions"
  19. 190  PRINT "Gregorian examples: 'SEP 1, 1982' or 'SEPTEMBER 1,1982'"
  20. 200  PRINT "                           ^             ^^^^^^ 3 char min"
  21. 210  PRINT "                           ^ space char optional"
  22. 220  PRINT "MM AND DD may be 1 or 2 digits"
  23. 230  PRINT "YY may be the last 2 digits of year or all 4 digits"
  24. 240  PRINT "Ordinal Day 1 = Jan 1, 1980": PRINT
  25. 250  PRINT "TO Quit press ENTER or       type 0"
  26. 260  PRINT "FOR Gregorian     to Ordinal type 1"
  27. 270  PRINT "FOR MM-DD-YY      to Ordinal type 2"
  28. 280  PRINT "FOR DEC Ordinal to Gregorian type 3"
  29. 290  INPUT "FOR HEX Ordinal to Gregorian type 4:  ",T
  30. 300  COLOR 7,0
  31. 310  ON T GOTO 330,420,790,750
  32. 320  END
  33. 330  PRINT: LINE INPUT "Enter: <MONTH_NAME><SPACE><DAY>,[SPACE]<YEAR> ";IN$
  34. 340  IF LEN(IN$) = 0 GOTO 150
  35. 350  MM$ = LEFT$(IN$,3): MM = 13 'ASSUME ERROR
  36. 360  FOR G = 1 TO 12
  37. 370  IF MID$(MONTH$,4*G-3,3) = MM$ THEN MM = G
  38. 380  NEXT G
  39. 390  IF MM = 13 THEN PRINT: PRINT "MONTH NOT FOUND": GOTO 300
  40. 400  B = INSTR(IN$," "): IF B = 0 GOTO 330
  41. 410  C = INSTR(B+2,IN$,","): IF C = 0 GOTO 330 ELSE C = C + 1: GOTO 500
  42. 420  PRINT: INPUT "INPUT MONTH-DAY-YEAR (MM-DD-YY)";IN$
  43. 430  IF LEN(IN$) = 0 GOTO 150
  44. 440  IF MID$(IN$,2,1) = "-" THEN B = 3: GOTO 460
  45. 450  IF MID$(IN$,3,1) = "-" THEN B = 4 ELSE GOTO 420
  46. 460  IF MID$(IN$,4,1) = "-" THEN C = 5: GOTO 490
  47. 470  IF MID$(IN$,5,1) = "-" THEN C = 6: GOTO 490
  48. 480  IF MID$(IN$,6,1) = "-" THEN C = 7 ELSE GOTO 420
  49. 490  MM=VAL(LEFT$(IN$,2)):IF MM<1 OR MM>12 THEN PRINT "MONTH ERROR":GOTO 300
  50. 500  DD=VAL(MID$(IN$,B,3)):IF DD<1 OR DD>31 THEN PRINT "DAY ERROR": GOTO 300
  51. 510  YY=VAL(MID$(IN$,C,5)): IF YY < 100 THEN YY = YY + 1900
  52. 520  IF YY < 1980 THEN PRINT "YEAR ERROR": GOTO 300
  53. 530  GOSUB 620  'DECIDE LEAPNESS
  54. 540  J = TBL(MM)+DD
  55. 550  YY = YY - 1980
  56. 560  L = INT((YY+3)\4)  'LEAP YEAR DAYS
  57. 570  ORD = YY*365+L+J
  58. 580  PRINT "Julian Day = ";J
  59. 590  PRINT "Ordinal Day = ";ORD
  60. 600  GOTO 300
  61. 610  'DECIDE LEAPNESS SUBROUTINE
  62. 620  RESTORE
  63. 630  FOR K = 1 TO 13
  64. 640  READ TBL(K)
  65. 650  NEXT K
  66. 660  IF YY MOD 4 <> 0 THEN RETURN
  67. 670  IF YY MOD 400 = 0 THEN RETURN
  68. 680  FOR K = 1 TO 13
  69. 690  READ TBL(K)
  70. 700  NEXT K
  71. 710  RETURN
  72. 720  DATA 0,31,59,90,120,151,181,212,243,273,304,334,365
  73. 730  DATA 0,31,60,91,121,152,182,213,244,274,305,335,366
  74. 740  'ORDINAL TO GREGORIAN CONVERSION
  75. 750  PRINT: INPUT "INPUT HEX ORDINAL DAY NO. = ",ORD$
  76. 760  IF LEN(ORD$) = 0 GOTO 150
  77. 770  GOSUB 1030
  78. 780  IF EFLAG = 0 GOTO 860 ELSE GOTO 300
  79. 790  PRINT: INPUT "INPUT DEC ORDINAL DAY NO. = ",ORD$
  80. 800  IF LEN(ORD$) = 0 GOTO 150
  81. 810  EFLAG = 0
  82. 820  FOR Q = 1 TO LEN(ORD$): D = ASC(MID$(ORD$,Q,1))
  83. 830  IF D < 48 OR D > 57 THEN EFLAG = 1: PRINT "DEC NO. ERROR": Q = LEN(ORD$)
  84. 840  NEXT Q
  85. 850  IF EFLAG = 1 GOTO 300 ELSE ORD = VAL(ORD$)
  86. 860  LEAPSETS = INT(ORD\1461) 'LEAPSET = 366 + (3*365)
  87. 870  REMAIN = ORD MOD 1461
  88. 880  YY = 4*LEAPSETS + 1980
  89. 890  IF REMAIN < 367 GOTO 930
  90. 900  REMAIN = REMAIN - 366: YY = YY + 1
  91. 910  IF REMAIN < 366 GOTO 930
  92. 920  REMAIN = REMAIN - 365: YY = YY + 1: GOTO 910
  93. 930  PRINT "Julian Day No. =";REMAIN
  94. 940  GOSUB 620  'DECIDE LEAPNESS
  95. 950  MM = INT(REMAIN\30) +1
  96. 960  IF TBL(MM) => REMAIN THEN MM = MM - 1
  97. 970  DD = REMAIN - TBL(MM)
  98. 980  MM$ = MID$(MONTH$,4*MM-3,3)
  99. 990  WKDAY = (ORD MOD 7)+1
  100. 1000  WKDAY$ = MID$(WEEK$,4*WKDAY-3,4)
  101. 1010  PRINT "Gregorian date = ";WKDAY$;MM$;:PRINT USING " ##";DD;:PRINT ",";YY
  102. 1020  GOTO 300
  103. 1030  'HE\ TO DECIMAL CONVERSION SUBROUTINE
  104. 1040  EFLAG = 0: ORD = 0
  105. 1050  FOR Q = 1 TO LEN(ORD$)
  106. 1060  D = ASC(MID$(ORD$,Q,1)) - 48
  107. 1070  IF D < 0 OR D > 22 THEN EFLAG = 1: GOTO 1110
  108. 1080  IF D > 9 AND D < 17 THEN EFLAG = 1: GOTO 1110
  109. 1090  IF D > 9 THEN D = D - 7
  110. 1100  ORD = 16*ORD + D
  111. 1110  NEXT Q
  112. 1120  IF EFLAG = 1 THEN PRINT "HEX NO. ERROR"
  113. 1130  RETURN
  114.